Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/forms/sticky/sticky.frm

Visual Basic Form | 1996-01-11 | 7.3 KB | 263 lines

VERSION 2.00
Begin Form frmSticky
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   1500
   ClientLeft      =   930
   ClientTop       =   1410
   ClientWidth     =   7245
   ControlBox      =   0   'False
   Height          =   1905
   Left            =   870
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1500
   ScaleWidth      =   7245
   Top             =   1065
   Width           =   7365
   Begin CommandButton Button
      Height          =   615
      Index           =   2
      Left            =   2640
      TabIndex        =   2
      Top             =   360
      Width           =   975
   End
   Begin CommandButton Button
      Height          =   615
      Index           =   1
      Left            =   1440
      TabIndex        =   1
      Top             =   360
      Width           =   975
   End
   Begin CommandButton Button
      Height          =   615
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   975
   End
Option Explicit
' This form is a "sticky" form. i.e. it acts like the
' Win95 taskbar. When dragged, it "sticks" to the nearest
' side of the screen.
' VERT_WIDTH & HORZ_HEIGHT define the size of
' the form in each position.
' BUTTON_WIDTH defines the width of the buttons when horz,
' and the height when vert.
' MoveType (assigned in Form_Load) specifies how the move
' is done:
'   MT_FORM: The whole form is re-drawn as you drag it.
'   MT_RECT: Only a rectangle is drawn while dragging, the
'            form is re-drawn only when mouse released.
' Accuracy (assigned in Form_Load) specifies how close
' the mouse must be to any side to switch positions:
'   ACC_EXACT: The mouse must be in the rectangle where
'              the form would be.
'   ACC_NEAREST: The side selected is the side the mouse
'                is closest to. (As per the Win95 taskbar)
Const MT_RECT = 1
Const MT_FORM = 2
Dim MoveType As Integer
Dim RectPos As Integer
Const ACC_EXACT = 1
Const ACC_NEAREST = 2
Dim Accuracy As Integer
Dim CurrentPos As Integer
Const POS_NONE = 0
Const POS_TOP = 1
Const POS_BOTTOM = 2
Const POS_LEFT = 3
Const POS_RIGHT = 4
Const LEFT_BUTTON = 1
Const VERT_WIDTH = 1000     ' twips
Const HORZ_HEIGHT = 1000    ' twips
Const BUTTON_WIDTH = 1000   ' twips
Sub Button_Click (Index As Integer)
    End
End Sub
Sub CalcPosition (CalcPos As Integer, x1!, x2!, y1!, y2!)
    Select Case CalcPos
    Case POS_TOP
    x1! = 0
    y1! = 0
    x2! = screen.Width
    y2! = HORZ_HEIGHT
    Case POS_BOTTOM
    x1! = 0
    y1! = screen.Height - HORZ_HEIGHT
    x2! = screen.Width
    y2! = screen.Height
    Case POS_LEFT
    x1! = 0
    y1! = 0
    x2! = VERT_WIDTH
    y2! = screen.Height
    Case POS_RIGHT
    x1! = screen.Width - VERT_WIDTH
    y1! = 0
    x2! = screen.Width
    y2! = screen.Height
    End Select
End Sub
Sub DrawFormHorizontal ()
Dim i As Integer
    For i = 0 To 2
    Button(i).Left = i * BUTTON_WIDTH * 1.5 + (BUTTON_WIDTH * .25)
    Button(i).Top = Me.Height / 4
    Button(i).Width = BUTTON_WIDTH
    Button(i).Height = Me.Height / 2
    Next i
End Sub
Sub DrawFormVertical ()
Dim i As Integer
    For i = 0 To 2
    Button(i).Top = i * BUTTON_WIDTH * 1.5 + (BUTTON_WIDTH * .25)
    Button(i).Left = Me.Width / 4
    Button(i).Height = BUTTON_WIDTH
    Button(i).Width = Me.Width / 2
    Next i
End Sub
Sub DrawRect (DrawPos As Integer)
Dim x1!, x2!, y1!, y2!, hDC%, RectRect As Rect
    If DrawPos <> RectPos Then
    hDC% = GetScreenDC(0)
    If hDC% Then

        ' Note: DrawFocusRect uses PIXELS !
        If RectPos <> POS_NONE Then
        ' First, un-draw previous rect
        CalcPosition RectPos, x1!, x2!, y1!, y2!
        RectRect.Left = CInt(x1! / screen.TwipsPerPixelX)
        RectRect.Top = CInt(y1! / screen.TwipsPerPixelY)
        RectRect.right = CInt(x2! / screen.TwipsPerPixelX)
        RectRect.bottom = CInt(y2! / screen.TwipsPerPixelY)
        DrawFocusRect hDC%, RectRect
        End If
        If DrawPos <> POS_NONE Then
        ' Then draw new one
        CalcPosition DrawPos, x1!, x2!, y1!, y2!
        RectRect.Left = CInt(x1! / screen.TwipsPerPixelX)
        RectRect.Top = CInt(y1! / screen.TwipsPerPixelY)
        RectRect.right = CInt(x2! / screen.TwipsPerPixelX)
        RectRect.bottom = CInt(y2! / screen.TwipsPerPixelY)
        DrawFocusRect hDC%, RectRect
        End If

        hDC% = ReleaseScreenDC(0, hDC%)
    End If
    RectPos = DrawPos
    End If
End Sub
Sub Form_Load ()
    CurrentPos = POS_NONE
    RectPos = POS_NONE
    MoveType = MT_RECT
    Accuracy = ACC_NEAREST
    SetPosition POS_BOTTOM
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, x As Single, y As Single)
    If MoveType = MT_RECT Then
    DrawRect CurrentPos
    End If
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
Dim sx!, sy!, NewPos As Integer
Dim x1!, x2!, y1!, y2!, mindiff!
    If (Button And LEFT_BUTTON) Then
    sx! = x + Me.Left
    sy! = y + Me.Top
    NewPos = POS_NONE
    Select Case Accuracy
    Case ACC_NEAREST
        x1! = Abs(sx!) * HORZ_HEIGHT
        x2! = Abs(screen.Width - sx!) * HORZ_HEIGHT
        y1! = Abs(sy!) * VERT_WIDTH
        y2! = Abs(screen.Height - sy!) * VERT_WIDTH
        If x1! < x2! Then
        mindiff! = x1!
        NewPos = POS_LEFT
        Else
        mindiff! = x2!
        NewPos = POS_RIGHT
        End If
        If mindiff! > y1! Then
        mindiff! = y1!
        NewPos = POS_TOP
        End If
        If mindiff! > y2! Then
        mindiff! = y2!
        NewPos = POS_BOTTOM
        End If
    Case ACC_EXACT
        If IsInRect(POS_TOP, sx!, sy!) Then
        NewPos = POS_TOP
        ElseIf IsInRect(POS_BOTTOM, sx!, sy!) Then
        NewPos = POS_BOTTOM
        ElseIf IsInRect(POS_LEFT, sx!, sy!) Then
        NewPos = POS_LEFT
        ElseIf IsInRect(POS_RIGHT, sx!, sy!) Then
        NewPos = POS_RIGHT
        End If
    End Select
    Select Case MoveType
    Case MT_RECT
        If Not IsInRect(RectPos, sx!, sy!) Or Accuracy = ACC_NEAREST Then
        DrawRect NewPos
        End If
    Case MT_FORM
        If Not IsInRect(CurrentPos, sx!, sy!) Or Accuracy = ACC_NEAREST Then
        If NewPos <> POS_NONE Then
            SetPosition NewPos
        End If
        End If
    End Select
    End If
End Sub
Sub Form_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)
Dim OldRectPos As Integer
    If MoveType = MT_RECT Then
    OldRectPos = RectPos
    DrawRect POS_NONE
    If OldRectPos <> POS_NONE Then
        SetPosition OldRectPos
    End If
    End If
End Sub
Function IsInRect (CheckPos As Integer, x As Single, y As Single) As Integer
Dim x1!, x2!, y1!, y2!
    CalcPosition CheckPos, x1!, x2!, y1!, y2!
    IsInRect = (x >= x1! And x <= x2! And y >= y1! And y <= y2!)
End Function
Sub SetPosition (NewPos As Integer)
Dim x1!, x2!, y1!, y2!
    If NewPos <> CurrentPos Then
    ' Calculate new spot
    CalcPosition NewPos, x1!, x2!, y1!, y2!
    ' hide window so flicker is minimised
    Me.Hide
    Me.Left = x1!
    Me.Top = y1!
    Me.Width = x2! - x1!
    Me.Height = y2! - y1!
    ' Re-draw objects in form
    Select Case NewPos
    Case POS_TOP
        DrawFormHorizontal
    Case POS_BOTTOM
        DrawFormHorizontal
    Case POS_LEFT
        DrawFormVertical
    Case POS_RIGHT
        DrawFormVertical
    End Select
    ' re-display form
    Me.Show 0
    ' record the new pos
    CurrentPos = NewPos
    End If
End Sub